perm filename TRANS1.LSP[206,JMC]1 blob sn#005319 filedate 1971-01-05 generic text, type T, neo UTF8
00100	(DE TRANSFORM (E R DONE) (COND ((MEMBER E DONE) E)
00200	(T ((LAMBDA (W) (COND ((EQ W E) (COND ((ATOM E) E) (T ((LAMBDA (X Y) (COND
00300	((AND (EQ X (CAR E)) (EQ Y (CDR E))) (SIDE E
00400	(SETQ DONE (CONS E DONE)))) (T (TRANSFORM (CONS X Y) R DONE))))
00500	(TRANSFORM (CAR E) R DONE) (TRANSFORM (CDR E) R DONE)))))
00600	(T (TRANSFORM W R DONE)))) (TRANSA E R)))))
00700	
00800	(DE TRANSA (E R) (COND ((NULL R) E) (T 
00900	((LAMBDA (W) (COND ((EQ W E) (TRANSA E (CDR R))) (T W)))
01000	(TRANSB E (CAR R))))))
01100	
01200	(DE TRANSB (E RULE) ((LAMBDA (W) (COND ((EQ W (QUOTE NO)) E)
01300	(T (SUBLIS (CADR RULE) W)))) (INST E (CAR RULE) NIL)))
01400	
01500	(DE SIDE (X Y) X)
01600	
01700	(SETQ R1 (QUOTE (
01800	((PLUS X.Y) (PLUSA X (PLUS.Y)))
01900	((PLUSA 0 . X) (PLUSA . X))
02000	((PLUS.NIL) (PLUSB.NIL))
02100	((PLUSA X (PLUSB.Y)) (PLUSB X.Y))
02200	((PLUSA (PLUSB . X)) (PLUSB . X))
02300	)))
02400	
02500	(SETQ R2 (QUOTE (
02600	((PLUS X . Y)  (PLUSA X (PLUS .Y)))
02700	((PLUS . NIL) 0)
02800	((PLUSA 0 . X) (PLUSA . X))
02900	((PLUSA) 0)
03000	((PLUSA X 0) X)
03100	((PLUSA X) X)
03200	((PLUSA (PLUSA X . Y) . Z) (PLUSA X (PLUSA . Y) .Z))
03300	
03400	((TIMES X . Y) (TIMESA X (TIMES . Y)))
03500	((TIMES) 1)
03600	((TIMESA 1 . X) (TIMESA . X))
03700	((TIMESA) 1)
03800	((TIMESA X 1) X)
03900	((TIMESA X) X)
04000	((TIMESA (TIMESA X . Y) . Z) (TIMESA X (TIMESA .Y) .Z))
04100	
04200	((TIMES 0 . X) 0)
04300	((TIMESA 0 . X) 0)
04400	)))
04500	
04600	
04700	(SETQ R3 (QUOTE (
04800	((PLUS X.Y) (X /+ .(PLUS.Y)))
04900	((/+ PLUS.NIL) NIL)
05000	)))
05100	
05200	(DE POOF (X Y) NIL)
05300	
05400	(DE PRLIS (X) (COND ((NULL X) NIL)
05500	 ((ATOM X) (POOF (PRINC X) NIL)) 
05600	 (T (POOF (PRINC (CAR X)) (PRLIS (CDR X))))))
05700	
05800	(SETQ R4 (QUOTE (
05900	((PLUSA X Y) (PLUS X Y))
06000	((PLUSA X (PLUS.Y)) (PLUS X . Y))
06100	)))